perm filename PX[PIC,LCS] blob
sn#081723 filedate 1974-01-12 generic text, type T, neo UTF8
00100 SUBROUTINE PLOU
00200
00300 COMMON/PLT/JX,JY,JPL,PLT,REV,RINV,IROT,RLR,RUD,CONST
00400 1 ,JREV,JINV,KA,KB,KC,KD,RTO,JA,JB,JAR,JBR
00500
00600 DIMENSION IDP1(4000),INP(10,20)
00700
00800 COMMON /LISTC/LIST(6,1000),LIST5(0/1000),NEWEND,LO
00900 COMMON/COMMAC/BCLIP,TCLIP,BITS,IWID,LINLEN,FLINE,LLINE,
01000 1 LSIDE,RSIDE,DTA,HYSTAB(1)
01100 INTEGER FLINE,RSIDE
01200 DATA NEWX/0/,NCNT/0/
01300 RTO=6
01600 JX=0
01700 JY=0
01800 JPL=1
01900
02000 1001 FORMAT(A1,9F)
02100 1000 FORMAT(' D(ISPLAY) P(LOT) OR M(OVE)? HORIZ.%,VERT.%,
02200 1 FOR CLEAR AREA L-R-BOT-TOP% REV=1, INV=1'/)
02220 1 JAR=0
02260 JBR=0
02300 TYPE 1000
02400 ACCEPT 1001,WHICH,RLR,RUD,A,B,C,D,REV,RINV,ROT
02410 IF(WHICH.NE.'T')GO TO 3002
02420 DO 4002 K=1,NCNT
02430 4002 TYPE 5002,(INP(NA,K),NA=1,10)
02440 GO TO 1000
02450 3002 IF(NCNT.LT.20.AND.WHICH.NE.WX)NCNT=NCNT+1
02460 REREAD 3,(INP(NA,NCNT),NA=1,10)
02465 WX=WHICH
02467 C SO IT WON'T COUNT RETRIES.
02470 3 FORMAT(10A5)
02485 5002 FORMAT(1X10A5)
02500 C FAC=SIZE BY 100'S, RLR=LEFT-RIGHT SIZE, RUD=UP-DOWN SIZE
02600 C-- D 0 0 0,50,0,50 CLEARS LOWER LFT QUAD. 50 100 50 100 UPR RT.
02610 C TYPE 'T' TO GET BACK ALL INPUT LINES.
02700 IF(A+B+C+D.EQ.0)A=-1.
02800 C 'N'= PLOT, BUT NO X
02900 IF(WHICH.EQ.'M')GO TO 2002
03000 IF(RLR.EQ.0)RLR=100.
03100 IF(RUD.EQ.0)RUD=100.
03110 IROT=-1
03120 IF(ROT.EQ.0)GO TO 2002
03160 IROT=0
03180 RINV=RINV-1
03200 2002 RLR=RLR/100.
03300 RUD=RUD/100.
03400 IF(WHICH.NE.'D')GO TO 1002
03500 PLT=0
03600 JPL=3
03700 C DPY IS 1/3 SIZE OF PLOT.
04100 GO TO 2000
04200
04300 1002 IF(WHICH.NE.'P'.AND.WHICH.NE.'N')GO TO 1102
04400 PLT=-1
04500 IF(NEWX.NE.-1)CALL PLOTS(I)
04600 GO TO 2
04700
04800 1102 IF(WHICH.NE.'M')GO TO 1000
04900 PLT=0
05000 C MOVE PEN, L-R%, U-D
05500 2200 RX=JQC-JQA+.5
05600 RY=JQD-JQB+.5
05700 JX=RX*RLR
05800 JY=RY*RUD
06200 RLR=.01
06300 RUD=.01
06400 GO TO 67
06500
06600 2 IF(WHICH.EQ.'N')GO TO 2000
06700 CALL PLOT(10,0,3)
06800 C MAKES AN X
06900 CALL PLOT(-10,0,2)
07000 CALL PLOT(0,10,3)
07100 CALL PLOT(0,-10,2)
07200 CALL PLOT(0,0,3)
07300
07400 2000 IF(NEWEND.GT.1000) PAUSE 'NEWEND>1000'
07600 C NEXT KEEPS ORIG. SIZE FACTORS
08200 50 FORMAT(' DO YOU WANT THE FRAME ?'/)
08300 IF(PLT.EQ.0)GO TO 67
08400 60 TYPE 50
08500 65 FORMAT(' LFT=',I4,' RT=',I4,' BOT=',I4,' TOP=',I4)
08600 ACCEPT 1001,ALFAB
08700 67 RA=LSIDE*(RTO*RLR)+.5
08800 RB=FLINE*(RTO*RUD)+.5
08900 RC=RSIDE*(RTO*RLR)+.5
09000 RD=LLINE*(RTO*RUD)+.5
09100 IF(NEWX.EQ.-1)GO TO 655
09200 JQA=RA
09300 JQB=RB
09400 JQC=RC
09500 JQD=RD
09600 655 JQX=JX
09700 JQY=JY
09800 JY=JY+120-RB
09900 JX=JX+36-RA
10000 C "ORIGINAL" POS IS SET 1ST TIME ONLY.
10100 JA=RA+JX
10200 JB=RB+JY
10300 JC=RC+JX
10400 JD=RD+JY
10500 IF(WHICH.EQ.'M')GO TO 671
10600 TYPE 657
10700 657 FORMAT(' OUTER LIMITS')
10800 TYPE 65,JA,JC,JB,JD
10900 C OUTER COORDINATES
11000 JREV=(JA+JC)/JPL
11100 JINV=(JB+JD)/JPL
11200 KA=0
11300 KB=0
11400 KC=0
11500 KD=0
11600 IF(A)GO TO 671
11700 KA=JA+(JC-JA)*(A/100.)
11800 KB=JA+(JC-JA)*(B/100.)
11900 KC=JB+(JD-JB)*(C/100.)
12000 KD=JB+(JD-JB)*(D/100.)
12100 IF(KB.LT.KA.OR.KD.LT.KC)GO TO 1
12200 TYPE 656
12300 656 FORMAT(/' CLEAR AREA')
12400 TYPE 65,KA,KB,KC,KD
12500 C CLEAR AREA COORDINATES
12600 671 NA=(JC-JA+2)/3
12800 NB=(JD-JB+2)/3
12900 NC=(JA+2)/3-380
13000 ND=(JB+2)/3-200
13100 IF(NEWX.NE.-1)CALL DPYSET(1,IDP1,4000)
13200 CALL SETPOG(1)
13300 CALL TYPLOC(-300,-611)
13400 CALL DPYBRT(6)
13405 MA=JA
13407 MB=JB
13410 CC IF(IROT)GO TO 672
13420 CC M=NC
13430 CC NC=ND
13440 CC ND=M
13450 C ROTATE THE FRAME TO LEFT 90 DEG.
13500 672 CALL AIVECT(NC,ND)
13503 JAR=0
13506 JBR=0
13510 JA=NA
13520 JB=0
13600 CALL LINES(2)
13610 JA=0
13613 JAR=0
13620 JB=NB
13700 CALL LINES(2)
13710 JA=-NA
13720 JB=0
13723 JBR=0
13800 CALL LINES(2)
13810 JA=0
13813 JAR=0
13820 JB=-NB
13900 CALL LINES(2)
14000 JA=MA
14100 JB=MB
14200 JBR=0
15500 CALL DPYOUT(1)
15600 IF(WHICH.NE.'M')GO TO 2683
15700 168 JY=JQY
15800 JX=JQX
15900 GO TO 1000
16000 2683 IF(A)GO TO 1683
16100 NA=KA/3-380
16200 NB=KB/3-380
16300 NC=KC/3-200
16400 ND=KD/3-200
16455 NPL=1
16460 IF(JPL.EQ.1)NPL=3
16500 IF(REV.EQ.0)GO TO 3683
16600 NA=JREV/NPL-KA/3-380
16700 NB=JREV/NPL-KB/3-380
16800 3683 IF(RINV.EQ.0)GO TO 4683
16900 NC=JINV/NPL-KC/3-200
17000 ND=JINV/NPL-KD/3-200
17100 4683 CALL DPYSET(2,LIST5,100)
17200 CALL DPYBRT(2)
17210 IF(IROT)GO TO 5683
17220 CALL ALINE(NC,NA,NC,NB)
17230 CALL AVECT(ND,NB)
17240 CALL AVECT(ND,NA)
17250 CALL AVECT(NC,NA)
17260 GO TO 6683
17300 5683 CALL ALINE(NA,NC,NB,NC)
17400 CALL AVECT(NB,ND)
17500 CALL AVECT(NA,ND)
17600 CALL AVECT(NA,NC)
17700 6683 CALL DPYOUT(2)
17800 KA=KA/JPL
17900 KB=KB/JPL
18000 KC=KC/JPL
18100 KD=KD/JPL
18200 1683 TYPE 683
18300 683 FORMAT(' OK?'/)
18400 ACCEPT 1001,NA
18500 IF(NA.EQ.'N')GO TO 168
18600 IF(PLT)GO TO 1681
18700 682 CALL CLRPOG(2)
18800 CALL SETPOG(1)
18810 NC=-380
18820 ND=-200
18830 IF(IROT)GO TO 684
18865 NC=NC+JX
18882 ND=ND+JY
18900 684 CALL AIVECT(NC,ND)
19100 681 IF(PLT.EQ.0)GO TO 68
19200 1681 IF(ALFAB.EQ.'N') GOTO 68
19250 NA=JA
19260 NB=JB
19300 CALL LINES(3)
19310 JA=JC
19400 CALL LINES(2)
19410 JB=JD
19500 CALL LINES(2)
19510 JA=NA
19600 CALL LINES(2)
19610 JB=NB
19700 CALL LINES(2)
19710 68 IF(IROT)GO TO 685
19720 NA=(JC-JA)/2-(JD-JB)/2
19730 JX=JX+NA
19740 JY=JY+NA
19770 CALL EXCH(JX,JY)
19800 685 JX=JX/JPL
19900 NEWX=-1
20000 JY=JY/JPL
20100 CALL PLTMAN
20110 JX=JQX
20120 JY=JQY
20150 WX=0
20200 END